home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Shareware World / Comms & Internet / HTML and CSS modes / HTML and CSS Modes / hctsmslShared.tcl < prev    next >
Text File  |  1998-11-01  |  31KB  |  962 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML and CSS mode - tools for editing Cascading Style Sheets
  4.  # 
  5.  #  FILE: "hctsmslShared.tcl"
  6.  #                                    created: 97-04-05 18.39.51 
  7.  #                                last update: 98-11-01 16.58.27 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.3 and 1.1
  13.  # 
  14.  # Copyright 1996-1998 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc hctsmslShared.tcl {} {}
  25.  
  26.  
  27. # A list of URLs, cached, to pick from for insertion
  28. newPref v URLs {} HTML
  29.  
  30. # Home pages, set the old one if it exists.
  31. if {[info exists homePagePath] && [string length $homePagePath] && 
  32. [info exists HTMLmodeVars(baseURL)] && [string length $HTMLmodeVars(baseURL)]} {
  33.     if {![info exists HTMLmodeVars(basePath)]} {set HTMLmodeVars(basePath) ""}
  34.     newPref v homePages [list [list [string trimright $homePagePath :] $HTMLmodeVars(baseURL) $HTMLmodeVars(basePath) "index.html"]] HTML
  35.     lappend modifiedModeVars {homePages HTMLmodeVars}
  36. } else {
  37.     newPref v homePages {} HTML
  38. }
  39.  
  40.  
  41. # Carriage return
  42. if {![alpha::package vsatisfies ${alpha::version} 7.1b1]} {
  43. proc HTML::carriageReturn {} {
  44.     global indentOnCR mode
  45.     
  46.     if { [isSelection] } { deleteSelection }
  47.     insertText "\r"
  48.     if {![info exists indentOnCR] || $indentOnCR} {
  49.         ${mode}::indentLine
  50.         if {![is::Whitespace [set pre [getText [lineStart [getPos]] [getPos]]]]} {
  51.             regexp {^[ \t]*} $pre white
  52.             goto [expr [lineStart [getPos]] + [string length $white]]
  53.         }
  54.     }
  55. }
  56. } else {
  57. proc HTML::carriageReturn {} {
  58.     global indentOnReturn mode
  59.     
  60.     if { [isSelection] } { deleteSelection }
  61.     insertText "\r"
  62.     if {![info exists indentOnReturn] || $indentOnReturn} {
  63.         ${mode}::indentLine
  64.         if {![is::Whitespace [set pre [getText [lineStart [getPos]] [getPos]]]]} {
  65.             regexp {^[ \t]*} $pre white
  66.             goto [expr [lineStart [getPos]] + [string length $white]]
  67.         }
  68.     }
  69. }
  70. }
  71. # Checks if the current position is inside the container ELEM.
  72. proc htmlIsInContainer {elem {pos ""}} {
  73.     set exp1 "<${elem}(\[ \t\r\]+\[^<>\]*>|>)"
  74.     set exp2 "</${elem}>"
  75.     if {$pos == ""} {set pos [getPos]}
  76.     if {![catch {search -s -f 0 -r 1 -i 1 -m 0 $exp1 $pos} res1] && $pos > [lindex $res1 1] &&
  77.     ([catch {search -s -f 0 -r 1 -i 1 -m 0 $exp2 $pos} res2] || 
  78.     [lindex $res1 0] > [lindex $res2 0])} {
  79.         return 1
  80.     }
  81.     return 0
  82. }
  83.  
  84. # Determines the path to the home page folder corresponding to path.
  85. # If none, return empty string.
  86. proc htmlWhichHomeFolder {path} {
  87.     global HTMLmodeVars
  88.     foreach p $HTMLmodeVars(homePages) {
  89.         if {[string match "[lindex $p 0]:*" $path] || [string match "[lindex $p 4]:*" $path]} {return $p}
  90.     }
  91.     return ""
  92. }
  93.  
  94.  
  95. # Determines the path to the include folder corresponding to path.
  96. # If none, return empty string.
  97. proc htmlWhichInclFolder {path} {
  98.     global HTMLmodeVars
  99.     foreach p $HTMLmodeVars(homePages) {
  100.         if {[string match "[lindex $p 0]:*" $path] || [string match "[lindex $p 4]:*" $path]} {return [lindex $p 4]:}
  101.     }
  102.     return ""
  103. }
  104.  
  105. proc htmlResolveInclPath {txt path} {
  106.     regsub -nocase {^:INCLUDE:} $txt $path txt
  107.     return $txt
  108. }
  109.  
  110. # Escapes certain characters in URLs.
  111. proc htmlURLescape {str {slash 0}} {
  112.     set hexa {0 1 2 3 4 5 6 7 8 9 A B C D E F}
  113.     set nstr ""
  114.     set exp "\[\001- \177-ˇ%<>\"#\?=&;|\\{\\}\\`^"
  115.     if {$slash} {append exp "/"}
  116.     append exp "\]"
  117.     while {[regexp -indices $exp $str c]} {
  118.         set asc [text::Ascii [string index $str [lindex $c 0]]]
  119.         append nstr [string range $str 0 [expr [lindex $c 0] - 1]]
  120.         append nstr % [lindex $hexa [expr $asc / 16]] [lindex $hexa [expr $asc % 16]]        
  121.         set str [string range $str [expr [lindex $c 1] + 1] end]
  122.     }
  123.     return "$nstr$str"
  124. }
  125.  
  126. proc htmlURLescape2 {str} {
  127.     set url ""
  128.     regexp {[^#]*} $str url
  129.     set anchor [string range $str [string length $url] end]
  130.     return "[htmlURLescape $url]$anchor"
  131. }
  132.  
  133. # Translate escaped characters in URLs.
  134. proc htmlURLunEscape {str} {
  135.     set hexa {0 1 2 3 4 5 6 7 8 9 A B C D E F}
  136.     set nstr ""
  137.     while {[regexp -indices {%[0-9A-F][0-9A-F]} $str hex]} {
  138.         append nstr [string range $str 0 [expr [lindex $hex 0] - 1]]
  139.         append nstr [text::Ascii [expr 16 * [lsearch $hexa [string index $str [expr [lindex $hex 0] + 1]]] \
  140.         + [lsearch $hexa [string index $str [expr [lindex $hex 0] + 2]]]] 1]
  141.         set str [string range $str [expr [lindex $hex 1] + 1] end]
  142.     }
  143.     return "$nstr$str"
  144. }
  145.  
  146. # Adds a URL or window given as input to cache
  147. proc htmlAddToCache {cache newurl} {
  148.     global modifiedModeVars HTMLmodeVars htmlModeIsLoaded
  149.     
  150.     if {$cache == "windows" && [lsearch -exact {_self _top _parent _blank} $newurl] >= 0} {return}
  151.     set URLs $HTMLmodeVars($cache)
  152.     
  153.     if {[string length $newurl] && [lsearch -exact $URLs $newurl] < 0} { 
  154.         set URLs [lsort [lappend URLs $newurl]]
  155.         set HTMLmodeVars($cache) $URLs
  156.         lappend modifiedModeVars [list $cache HTMLmodeVars]
  157.         if {[set l [llength $URLs]] == 1 && [info exists htmlModeIsLoaded]} {htmlEnable$cache on}
  158.         if {$l > 75 && [expr $l/10 == $l/10.0]} {
  159.             alertnote "The $cache cache is very large. Consider cleaning it up."
  160.         }
  161.     }
  162. }
  163.  
  164.  
  165. # Puts up a window with error text.
  166. proc htmlErrorWindow {errHeader errText {cancelButton 0}} {
  167.     
  168.     set errbox "-t {$errHeader} 100 10 400 25"
  169.     set hpos 35
  170.     foreach err $errText {
  171.         lappend errbox -t $err 10 $hpos 400 [expr $hpos + 15]
  172.         incr hpos 20
  173.     }
  174.     if {$cancelButton} {
  175.         lappend errbox -b Cancel 105 [expr $hpos + 20 ] 170 [expr $hpos + 40 ]
  176.     }
  177.     
  178.     set val [eval [concat dialog -w 430 -h [expr $hpos + 50 ] \
  179.     -b OK 20 [expr $hpos + 20 ] 85 [expr $hpos + 40 ] $errbox]]
  180.     return [lindex $val 0]
  181. }
  182.  
  183. # Caches
  184. proc htmlSaveCache {cache text {type html}} {
  185.     global PREFS htmlVersion cssVersion
  186.     if {![file exists $PREFS]} {mkdir $PREFS}
  187.     if {![file exists $PREFS:HTML]} {mkdir $PREFS:HTML}
  188.     set fid [open $PREFS:HTML:$cache w]
  189.     puts $fid "#[set ${type}Version]"
  190.     puts $fid $text
  191.     close $fid
  192. }
  193.  
  194. proc htmlReadCache {cache {type html}} {
  195.     global PREFS htmlVersion cssVersion
  196.     if {![file exists $PREFS:HTML:$cache]} {error "No cache."}
  197.     set fid [open $PREFS:HTML:$cache r]
  198.     gets $fid version
  199.     if {![regexp {^#[0-9]+\.[0-9]+$} $version] || $version != "#[set ${type}Version]"} {
  200.         close $fid
  201.         htmlDeleteCache $cache
  202.         error "Wrong version."
  203.     }
  204.     close $fid
  205.     uplevel #0 [list source $PREFS:HTML:$cache]
  206. }
  207.  
  208. proc htmlDeleteCache {cache} {
  209.     global PREFS
  210.     catch {removeFile $PREFS:HTML:$cache}
  211. }
  212.  
  213. #===============================================================================
  214. # File routines
  215. #===============================================================================
  216.  
  217. # Asks for a file and returns the file name including the relative path from
  218. # current window. For images the width and height are also returned.
  219. proc htmlGetFile {{addtocache 1} {linkFile ""} {errormsg 0}} {
  220.     upvar pathToNewFile newFile
  221.     # get path to this window.    
  222.     if {![string length [set this [htmlThisFilePath $errormsg]]]} {return}
  223.     
  224.     # Get the file to link to.
  225.     if {$linkFile == "" && [catch {getfile "Select file to link to."} linkFile]} {
  226.         return 
  227.     }
  228.     # For htmlLinkToNewFile
  229.     set newFile $linkFile
  230.     # Get URL for this file?
  231.     set link [htmlBASEfromPath $linkFile]
  232.     if {[lindex $link 4] == "4"} {
  233.         alertnote "You can't link to a file in an include folder."
  234.         return
  235.     }
  236.     if {[lindex $this 4] == "4" && "[lindex $this 0][lindex $this 1]" == "[lindex $link 0][lindex $link 1]"} {
  237.         set linkTo ":HOMEPAGE:[lindex $link 2]"
  238.     } elseif {[lindex $this 0] == [lindex $link 0]} {
  239.         set linkTo [htmlRelativePath "[lindex $this 1][lindex $this 2]" "[lindex $link 1][lindex $link 2]"]
  240.     } else {
  241.         set linkTo [join [lrange $link 0 2] ""]
  242.     }
  243.     set widthheight ""
  244.     if {![file isdirectory $linkFile]} {
  245.         # Check if image file.
  246.         getFileInfo $linkFile arr
  247.         if {$arr(type) == "GIFf"} {
  248.             set widthheight [htmlGIFWidthHeight $linkFile]
  249.         } elseif {$arr(type) =="JPEG" || $arr(type) == "JFIF"} {
  250.             set widthheight [htmlJPEGWidthHeight $linkFile]
  251.         }
  252.     } else {
  253.         append linkTo /
  254.     }
  255.     # Add URL to cache
  256.     if {$addtocache} {htmlAddToCache URLs $linkTo}
  257.     return [list $linkTo $widthheight]
  258. }
  259.  
  260.  
  261. # Returns the URL to the current window.
  262. proc htmlThisFilePath {errorMsg} {
  263.     
  264.     set thisFile [stripNameCount [lindex [winNames -f] 0]]
  265.     
  266.     # Look for BASE element.
  267.     if {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<BASE[ \t\r]+[^>]*>} 0} res]} {
  268.         set comm 0
  269.         set commPos 0
  270.         while {![catch {search -s -f 1 -r 0 -m 0 -l [lindex $res 0] {<!--} $commPos} cres]} {
  271.             set comm 1
  272.             if {![catch {search -s -f 1 -r 0 -m 0 -l [lindex $res 0] -- {-->} [expr [lindex $cres 1] + 1]} cres]} {
  273.                 set comm 0
  274.                 set commPos [lindex $cres 1]
  275.             } else {
  276.                 break
  277.             }
  278.         }
  279.         if {!$comm && [regexp -nocase {HREF=\"?([^ \t\r\">]+)} [getText [lindex $res 0] \
  280.         [lindex $res 1]] dum href]} {
  281.             if {[catch {htmlBASEpieces $href} basestr]} {
  282.                 alertnote "Window contains invalid BASE element. Ignored."
  283.             } else {
  284.                 return $basestr
  285.             }
  286.         }
  287.     }
  288.     
  289.     # Check if window is saved.
  290.     if {![file exists $thisFile]} {
  291.         switch $errorMsg {
  292.             0 {
  293.                 set etxt "You must save the window. If you save, you will then be prompted\
  294.                 for a file to link to."
  295.             }
  296.             1 {
  297.                 set etxt "You must save the window, otherwise it cannot be determined\
  298.                 where the link is pointing."
  299.             }
  300.             2 {
  301.                 set etxt "You must save the window, otherwise the link cannot be determined."
  302.             }
  303.             3 {
  304.                 set etxt "You must save the window, otherwise it cannot be determined\
  305.                 where the links are pointing."
  306.             }
  307.             4 {
  308.                 set etxt "You must save the window, otherwise it cannot be determined\
  309.                 where to upload it."
  310.             }
  311.         }
  312.         if {[lindex [dialog -w 400 -h 100 -t $etxt 10 10 390 60  \
  313.         -b Save 20 70  85 90 \
  314.         -b Cancel 110 70 175 90] 1]} {
  315.             return
  316.         }
  317.         
  318.         if {![catch {saveAs "Untitled.html"}]} {
  319.             set thisFile [stripNameCount [lindex [winNames -f] 0]]
  320.         } else {
  321.             return 
  322.         }
  323.     }
  324.     return [htmlBASEfromPath $thisFile]
  325. }
  326.  
  327. # Returns URL to file.
  328. proc htmlBASEfromPath {path} {
  329.     global HTMLmodeVars
  330.     foreach p $HTMLmodeVars(homePages) {
  331.         if {(![set i 0] && [string match "[lindex $p $i]:*" "$path:"]) || 
  332.         ([llength $p] == 5 && [set i 4] && [string match "[lindex $p $i]:*" "$path:"])} {
  333.             set path [string range $path [expr [string length [lindex $p $i]] + 1] end]
  334.             regsub -all {:} $path {/} path
  335.             return [list [lindex $p 1] [lindex $p 2] $path [lindex $p 0] $i [lindex $p 4]]
  336.         }
  337.     }
  338.     regsub -all {:} $path {/} path
  339.     return [list "file:///" "" $path "" 0]
  340. }
  341.  
  342. # Splits a BASE URL in pieces.
  343. # NOTE! That this proc returns a shorter list than the proc above, is used in
  344. # HTML::DblClick to determine if the doc contains a BASE tag.
  345. proc htmlBASEpieces {href} {
  346.     if {[regexp -indices {://} $href css]} {
  347.         if {[set sl [string first / [string range $href [expr [lindex $css 1] + 1] end]]] >=0} {
  348.             set base [string range $href 0 [expr [lindex $css 1] + $sl + 1]]
  349.             set path [string range $href [expr [lindex $css 1] + $sl + 2] end]
  350.             set sl [string last / $path]
  351.             set epath [string range $path [expr $sl + 1] end]
  352.             set path [string range $path 0 $sl]
  353.         } else {
  354.             set base [string range $href 0 [lindex $css 1]]
  355.             set path ""
  356.             set epath [string range $href [expr [lindex $css 1] + 1] end]
  357.         }
  358.         return [list [htmlURLunEscape $base] [htmlURLunEscape $path] [htmlURLunEscape $epath] ""]
  359.     } else {
  360.         error "Invalid BASE."
  361.     }
  362. }
  363.  
  364.  
  365. # Determines width and height of a GIF file.
  366. proc htmlGIFWidthHeight {fil} {
  367.     if {[catch {open $fil r} fid]} {return}
  368.     seek $fid 6 start
  369.     set width [expr [htmlReadOne $fid] + 256 * [text::Ascii [read $fid 1]]]
  370.     set height [expr [htmlReadOne $fid] + 256 * [text::Ascii [read $fid 1]]]
  371.     close $fid
  372.     return [list $width $height]
  373. }
  374.  
  375. # Extracts width and height of a jpeg file.
  376. # Algorithm from the perl script 'wwwimagesize' by
  377. # Alex Knowles, alex@ed.ac.uk
  378. # Andrew Tong, werdna@ugcs.caltech.edu
  379. proc htmlJPEGWidthHeight {fil} {
  380.     if {[catch {open $fil r} fid]} {return}
  381.     if {[text::Ascii [read $fid 1]] != 255 || [text::Ascii [read $fid 1]] != 216} {return}
  382.     set ch ""
  383.     while {![eof $fid]} {
  384.         while {[text::Ascii $ch] != 255 && ![eof $fid]} {set ch [read $fid 1]}
  385.         while {[text::Ascii $ch] == 255 && ![eof $fid]} {set ch [read $fid 1]}
  386.         if {[set asc [text::Ascii $ch]] >= 192 && $asc <= 195} {
  387.             seek $fid 3 current
  388.             set height [expr 256 * [text::Ascii [read $fid 1]] + [htmlReadOne $fid]]
  389.             set width [expr 256 * [text::Ascii [read $fid 1]] + [htmlReadOne $fid]]
  390.             close $fid
  391.             return [list $width $height]
  392.         } else {
  393.             set ln [expr 256 * [text::Ascii [read $fid 1]] + [text::Ascii [read $fid 1]] - 2]
  394.             if {$ln < 0} {break}
  395.             seek $fid $ln current
  396.         }
  397.     }
  398.     close $fid
  399. }
  400.  
  401. # Reads one character from an image file.
  402. # For some mysterious reason 10 and 13 has to be swapped.
  403. proc htmlReadOne {fid} {
  404.     set c [text::Ascii [read $fid 1]]
  405.     if {$c == 13} {
  406.         set c 10
  407.     } elseif {$c == 10} {
  408.         set c 13
  409.     }
  410.     return $c
  411. }
  412.  
  413.  
  414. # Returns toFile including relative path from fromFile.
  415. proc htmlRelativePath {fromFile toFile} {
  416.     # Remove trailing /file from fromFile
  417.     set fromFile [string range $fromFile 0 [expr [string last / $fromFile] - 1]]
  418.  
  419.     set fromdir [split $fromFile /]
  420.     set todir [split $toFile /]
  421.     
  422.     # Remove the common path.
  423.     set i 0
  424.     while {[llength $fromdir] > $i && [llength $todir] > $i \
  425.     && [lindex $fromdir $i] == [lindex $todir $i]} {
  426.         incr i
  427.     }
  428.  
  429.     # Insert ../
  430.     foreach f [lrange $fromdir $i end] {
  431.         append linkTo "../"
  432.     }
  433.     # Add the path.
  434.     append linkTo [join [lrange $todir $i end] /]
  435.     
  436.     return $linkTo
  437. }
  438.  
  439. # Determine the path to the file "linkTo", as linked from "base path epath". 
  440. proc htmlPathToFile {base path epath hpPath linkTo} {
  441.     global  HTMLmodeVars
  442.     # Expand links in include files.
  443.     regsub -nocase {^:HOMEPAGE:} $linkTo "$base$path" linkTo
  444.     # Is this a mailto or news URL or anchor?
  445.     if {[regexp {^(mailto:|news:|javascript:)} [string tolower $linkTo]]} {error $linkTo}
  446.     
  447.     # remove /file from epath
  448.     set sl [string last / $epath]
  449.     set efil [string range $epath [expr $sl + 1] end]
  450.     set epath [string range $epath 0 $sl]
  451.  
  452.     # anchor points to efil
  453.     if {[string index $linkTo 0] == "#"} {set linkTo $efil}
  454.     
  455.     # Remove anchor from "linkTo".
  456.     regexp {[^#]*} $linkTo linkTo
  457.     
  458.     # Remove ./ from path
  459.     if {[string range $linkTo 0 1] == "./"} {set linkTo [string range $linkTo 2 end]}
  460.     
  461.     # Relative URL beginning with / is relative to server URL.
  462.     if {[string index $linkTo 0] == "/"} {
  463.         set linkTo "$base[string range $linkTo 1 end]"
  464.     }
  465.     
  466.     # Relative URL?
  467.     if {![regexp  {://} $linkTo]} {
  468.         set fromPath [split [string trimright "${path}$epath" /] /]
  469.         set toPath [split $linkTo /]
  470.         # Back down for every ../
  471.         set i 0
  472.         foreach tp $toPath {
  473.             if {$tp == ".."} {
  474.                 incr i
  475.             } else {
  476.                 break
  477.             }
  478.         }
  479.         if {$i > [llength $fromPath] } {
  480.             error ""
  481.         } else {
  482.             set path1 [join [lrange $fromPath 0 [expr [llength $fromPath] - $i - 1]] /]
  483.             if {[string length $path1]} {append path1 /}
  484.             append path1 [join [lrange $toPath $i end] /]
  485.             if {[string match "$path*" $path1] && [string length $hpPath]} {
  486.                 set pathTo [string range $path1 [string length $path] end]
  487.                 regsub -all {/} $pathTo {:} pathTo
  488.                 set casePath $pathTo
  489.                 set pathTo "$hpPath:$pathTo"
  490.                 if {![file isdirectory $pathTo]} {return [list $pathTo $casePath]}
  491.             } elseif {$base == "file:///"} {
  492.                 regsub -all {/} $path1 {:} pathTo
  493.                 return [list $pathTo $pathTo]
  494.             }
  495.             set linkTo "$base$path1"
  496.         }
  497.     }
  498.  
  499.     foreach hp [concat $HTMLmodeVars(homePages) {{"" file:/// "" ""}}]  {
  500.         if {[string match "[lindex $hp 1][lindex $hp 2]*" $linkTo] ||
  501.         [string trimright "[lindex $hp 1][lindex $hp 2]" /] == $linkTo} {
  502.             set pathTo [string range $linkTo [string length "[lindex $hp 1][lindex $hp 2]"] end]
  503.             regsub -all {/} $pathTo {:} pathTo
  504.             set casePath $pathTo
  505.             set pathTo [string trimleft "[lindex $hp 0]:$pathTo" :]
  506.             # If link to folder, add default file.
  507.             if {[file isdirectory $pathTo]} {
  508.                 set pathTo [string trimright $pathTo :]
  509.                 append pathTo ":[lindex $hp 3]"
  510.                 set casePath [string trimright $casePath :]
  511.                 append casePath ":[lindex $hp 3]"
  512.             }        
  513.             return [list $pathTo [string trimleft $casePath :]]
  514.         }
  515.     }
  516.     error $linkTo
  517. }    
  518.  
  519. #===============================================================================
  520. # Cmd-Double-click
  521. #===============================================================================
  522.  
  523. proc HTML::DblClick {from to} {
  524.     global htmlURLAttr mode 
  525.     global ${mode}modeVars filepats
  526.     
  527.     # Build regular expressions with URL attrs.
  528.     if {$mode == "HTML"} {
  529.         set exp "("
  530.         foreach attr $htmlURLAttr {
  531.             append exp "$attr|"
  532.         }
  533.         set exp [string trimright $exp |]
  534.         append exp ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  535.     }
  536.  
  537.     set expcss {(url)\(\"?([^\"\)]+)\"?\)}
  538.     # Check if user clicked on a link.
  539.     if {($mode == "HTML" && ![catch {search -s -f 0 -r 1 -i 1 -m 0 $exp $from} res] && [lindex $res 1] > $from) ||
  540.     (![set curl [catch {search -s -f 0 -r 1 -i 1 -m 0 $expcss $from} res]] && [lindex $res 1] > $from)} {
  541.         # Get path to this window.
  542.         if {![string length [set thisURL [htmlThisFilePath 1]]]} {return}
  543.         # Get path to link.
  544.         if {[info exists curl]} {set exp $expcss}
  545.         regexp -nocase $exp [eval getText $res] dum1 dum2 linkTo
  546.         set linkTo [htmlURLunEscape [string trim $linkTo \"]]
  547.         # Anchors points to file itself if no BASE. (No BASE if [llength $thisURL] > 4)
  548.         if {[string index $linkTo 0] == "#" && [llength $thisURL] > 4} {
  549.             if {![catch {search -s -f 1 -r 1 -i 1 -m 0 \
  550.                 "<(A|MAP)\[ \t\r\n\]+\[^>\]*NAME=\"?[string range $linkTo 1 end]\"?(>|\[ \t\r\n\]+\[^>\]*>)" 0} anc]} {
  551.                 goto [lindex $anc 0]
  552.                 insertToTop
  553.             }
  554.             return
  555.         }
  556.         if {[catch {lindex [htmlPathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  557.             if {$linkToPath == ""} {
  558.                 message "Link not well-defined."
  559.             } else {
  560.                 message "Link points to $linkToPath. Doesn't map to a file on the disk."
  561.             }
  562.             return
  563.         }
  564.         # Does the file exist? 
  565.         if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  566.             # Is it a text file?
  567.             if {[getFileType $linkToPath] == "TEXT"} {
  568.                 edit -c $linkToPath
  569.                 if {[regexp {[^#]*#(.+)$} $linkTo dum anchor] && ![catch {search -s -f 1 -r 1 -i 1 -m 0 \
  570.                   "<(A|MAP)\[ \t\r\n\]+\[^>\]*NAME=\"?$anchor\"?(>|\[ \t\r\n\]+\[^>\]*>)" 0} anc]} {
  571.                     goto [lindex $anc 0]
  572.                     insertToTop
  573.                 }
  574.             } elseif {[set ${mode}modeVars(openNonTextFile)] && [getFileType $linkToPath] != "APPL"} {
  575.                 launchDoc $linkToPath
  576.             } else {
  577.                 message "[file tail $linkToPath] is not a text file."
  578.             }
  579.         } else {
  580.             set isAnHtmlFile 0
  581.             set sufficies ""
  582.             foreach mm {HTML CSS JScr} {
  583.                 if {[info exists filepats($mm)]} {set sufficies [concat $sufficies $filepats($mm)]}
  584.             }
  585.             foreach suffix $sufficies {
  586.                 if {[string match $suffix $linkToPath]} {set isAnHtmlFile 1}
  587.             }
  588.             if {(![file exists $linkToPath] && !$isAnHtmlFile) || [file isdirectory $linkToPath] ||
  589.             ![regexp {[^:]+} $linkToPath disk] || ![file exists $disk:]} {
  590.                 message "Cannot open [file tail $linkToPath]."
  591.             } else {
  592.                 set htmlFile [file tail $linkToPath]
  593.                 if {[lindex [dialog -w 350 -h 140 -t "The file '$htmlFile' does not exist.\
  594.                 Do you want to open a new empty window with this name?\
  595.                 It will automatically be saved in the right place,\
  596.                 and if necessary, new folders will be created."  10 10 340 100 \
  597.                 -b Yes 20 110 85 130 -b No 115 110 180 130] 1]} {return}
  598.                 # Create a new file and open it.
  599.                 foreach p [split [file dirname $linkToPath] :] {
  600.                     append path "$p:"
  601.                     # make new folders if needed.
  602.                     if {![file exists $path]} {
  603.                         mkdir $path
  604.                     } elseif {![file isdirectory $path]} {
  605.                         alertnote "Cannot make a new folder '[file tail $path]'.\
  606.                         There is already a file with the same name."
  607.                         return
  608.                     }
  609.                 }
  610.                 append path "$htmlFile"
  611.                 # create an empty file.
  612.                 set fid [open $path w]
  613.                 # I suppose it's best to close it, too.
  614.                 close $fid
  615.                 edit $path
  616.             }
  617.         }
  618.     } elseif {$mode == "HTML"} { 
  619.         if {![catch {search -s -f 0 -r 1 -i 1 -m 0 {FILE=\"[^\"]+\"} $from} res] && [lindex $res 1] > $from} {
  620.             regexp -nocase {FILE=\"([^\"]+)\"} [eval getText $res] dum fil
  621.             set fil [htmlResolveInclPath [htmlUnQuote $fil] [htmlWhichInclFolder [stripNameCount [lindex [winNames -f] 0]]]]
  622.             if {[file exists $fil]} {
  623.                 edit -c $fil
  624.             } else {
  625.                 message "File not found."
  626.             }
  627.         } elseif {[htmlIsInContainer SCRIPT]} {
  628.             global HOME
  629.             select $from $to
  630.             set word [getText $from $to]
  631.             if {[grep "^${word}( |$)" [lindex [glob $HOME:JSreference:index*] 0]] != ""} {
  632.                 editMark [lindex [glob $HOME:JSreference:JS*] 0] $word -r
  633.             }
  634.         } elseif {![htmlRevealColor 1]} {
  635.             htmlChangeDblClick
  636.         }
  637.     }
  638. }
  639.  
  640. #==============================================================================
  641. #    Colors
  642. #==============================================================================
  643.  
  644. # Convert colour names to numbers and vice versa.
  645. # Or brings up a color picker if cmd-doubleClick.
  646. proc htmlRevealColor {{dblClick 0}} {
  647.     global htmlColorName htmlColorNumber htmlColorAttr htmluserColors 
  648.     global htmluserColorname
  649.  
  650.     set searchstring "("
  651.     foreach s $htmlColorAttr {
  652.         append searchstring "${s}|"
  653.     } 
  654.     # remove last |
  655.     set searchstring [string trimright $searchstring |]
  656.     append searchstring ")(\"(\[^\"\]*)\"|(\[^ \\t\\r\">\]*))"
  657.     set startpos [getPos]
  658.     set endpos [selEnd]
  659.     set cantfind 0
  660.     # find attribute
  661.     set f [search -s -f 0 -r 1 -i 1 -n -m 0 $searchstring $startpos]
  662.     if {![string length $f] || [lindex $f 1] < $endpos} {
  663.         set cantfind 1
  664.     }
  665.     if {!$cantfind} {
  666.         set txt [getText [lindex $f 0] [lindex $f 1]]
  667.         regexp -indices -nocase $searchstring $txt a b c
  668.         set cpos [expr [lindex $f 0] + [lindex $c 0]]
  669.         set epos [expr [lindex $f 0] + [lindex $c 1] + 1]
  670.         set col [string trim [string range $txt [lindex $c 0] [lindex $c 1]] \"]
  671.         if {!$dblClick} {
  672.             if {[info exists htmlColorName($col)]} {
  673.                 replaceText $cpos $epos "\"$htmlColorName($col)\""
  674.             } elseif {[info exists htmlColorNumber($col)]} {
  675.                 replaceText $cpos $epos "\"$htmlColorNumber($col)\""
  676.             } elseif {[info exists htmluserColorname($col)]} {
  677.                 replaceText $cpos $epos "\"$htmluserColorname($col)\""
  678.             } elseif {[info exists htmluserColors($col)]} {
  679.                 replaceText $cpos $epos "\"$htmluserColors($col)\""
  680.             } else {
  681.                 beep
  682.                 message "Don't recognize color."
  683.             }
  684.         } else {
  685.             if {[set ncol [htmlCheckColorNumber $col]] != "0"} {
  686.                 set ncol [htmlHexColor $ncol]
  687.             } else {
  688.                 set ncol {65535 65535 65535}
  689.             }
  690.             set newcolor [eval [concat colorTriple {{Change color}} $ncol]]
  691.             if {[string length $newcolor]} {
  692.                 replaceText $cpos $epos "\"[htmlColorHex $newcolor]\""
  693.             }
  694.             return 1
  695.         }
  696.     } elseif {!$dblClick} {
  697.         beep
  698.         message "Current position is not at a color attribute."
  699.     } else {
  700.         return 0
  701.     }
  702. }
  703.  
  704. # Dialog to handle colors.
  705. proc htmlColors {} {
  706.     global htmluserColors
  707.  
  708.     set this ∞
  709.     while {1} {
  710.         set colors [lsort [array names htmluserColors]]
  711.         set box "-t {Colors:} 10 10 80 30 \
  712.         -t Number: 10 50 80 70 \
  713.         -b Done 10 100 75 120 -b New… 90 100 155 120 -b {New by number…} 250 10 375 30"
  714.         if {[llength $colors]} {
  715.             append box " -m [list [concat [list $this] $colors]] 90 10 230 30"
  716.             append box " -b Change… 168 100 237 120 -b Remove 250 100 315 120 \
  717.             -b {Change number…} 250 40 375 60 -b View… 250 70 315 90"
  718.             foreach c $colors {
  719.                 lappend box -n $c -t $htmluserColors($c) 90 50 160 90
  720.             }
  721.         } else {
  722.             append box  " -m {{None defined} {None defined}} 90 10 230 30"
  723.         }
  724.         set values [eval [concat dialog -w 380 -h 130 $box]]
  725.         set this [lindex $values 3]
  726.         if {[lindex $values 0]} {
  727.             return
  728.         } elseif {[lindex $values 1]} {
  729.             set newc [htmlAddNewColor]
  730.             if {[string length $newc]} {set this $newc}
  731.         } elseif {[lindex $values 2]} {
  732.             set newc [htmlNameColor "" "Color saved." "" ""]
  733.             if {[string length $newc]} {set this $newc}
  734.         } elseif {[lindex $values 4]} {
  735.             set newcolor [eval [concat colorTriple [list $this] [htmlHexColor $htmluserColors($this)]]]
  736.             if {![string length $newcolor]} {continue}
  737.             set newc [htmlNameColor [htmlColorHex $newcolor] "Color changed." $this $htmluserColors($this)]
  738.             if {[string length $newc]} {set this $newc}        
  739.         } elseif {[lindex $values 5]} {
  740.             if {[askyesno "Remove $this?"] == "yes"} {
  741.                 htmlColordelete $this $htmluserColors($this)
  742.                 message "Color removed."
  743.             }
  744.         } elseif {[lindex $values 6]} {
  745.             set newc [htmlNameColor "" "Color changed." $this $htmluserColors($this)]
  746.             if {[string length $newc]} {set this $newc}        
  747.         } else {
  748.             eval [concat colorTriple [list $this] [htmlHexColor $htmluserColors($this)]]
  749.         }
  750.     }
  751. }
  752.  
  753. # Checks if colornumber is identical to another colour.
  754. proc htmlColorIdentical {colornumber changeColor} {
  755.     global htmlColorNumber htmluserColorname
  756.     if {( ![catch {set colTest $htmlColorNumber($colornumber)}] || \
  757.     ![catch {set colTest $htmluserColorname($colornumber)}] ) && \
  758.     $colTest != $changeColor} {
  759.         alertnote "This color is identical with '$colTest'. Two identical \
  760.         colors cannot be defined."
  761.         return 1
  762.     }
  763.     return 0
  764. }
  765.  
  766. # Converts a red green blue number to hex.
  767. proc htmlColorHex {color} {
  768.     set hexa {A B C D E F}
  769.     
  770.     set red [expr [lindex $color 0] / 256]
  771.     set green [expr [lindex $color 1] / 256]
  772.     set blue [expr [lindex $color 2] / 256]
  773.     set cols [list [expr $red / 16] [expr $red % 16] [expr $green / 16] [expr $green % 16] [expr $blue / 16] [expr $blue % 16]]
  774.     set colornumber {#}
  775.     foreach c $cols {
  776.         if {$c > 9} {
  777.             set c1 [lindex $hexa [expr $c - 10]]
  778.         } else {
  779.             set c1 $c
  780.         }
  781.         append colornumber $c1
  782.     }
  783.     return $colornumber
  784. }
  785.  
  786. # Converts a hex number to red green blue.
  787. proc htmlHexColor {number} {
  788.     foreach c [split [string range $number 1 end] ""] {
  789.         switch $c {
  790.             A    {set c1 10}
  791.             B    {set c1 11}
  792.             C    {set c1 12}
  793.             D    {set c1 13}
  794.             E    {set c1 14}
  795.             F    {set c1 15}
  796.             default {set c1 $c}
  797.         }
  798.         lappend numbers $c1
  799.     }
  800.     set red [expr [lindex $numbers 0] * 4096 + [lindex $numbers 1] * 256]
  801.     set green [expr [lindex $numbers 2] * 4096 + [lindex $numbers 3] * 256]
  802.     set blue [expr [lindex $numbers 4] * 4096 + [lindex $numbers 5] * 256]
  803.     return [list $red $green $blue]
  804. }    
  805.  
  806. proc htmlAddNewColor {} {
  807.     set newcolor [colorTriple "New color"]    
  808.     if {![string length $newcolor]} {return }
  809.     return [htmlNameColor [htmlColorHex $newcolor] "Color saved." "" ""]
  810. }
  811.  
  812. proc htmlNameColor {colornumber msg changeColor changeNumber} {
  813.     global htmluserColors basicColors
  814.     set alluserColors [array names htmluserColors]
  815.     set noname 1
  816.     set picker [string length $colornumber]
  817.     set values [list $changeColor $changeNumber]
  818.     while {$noname} {
  819.         if {!$picker} {
  820.             if {[string length $changeColor]} {
  821.                 set ttt Change
  822.             } else {
  823.                 set ttt New
  824.             }
  825.             set values [dialog -w 300 -h 150 -t "$ttt color" 50 10 250 30 \
  826.             -t "Name:" 10 45 75 65 -e [lindex $values 0] 80 45 290 60 \
  827.             -t "Number:" 10 75 75 95 -e [lindex $values 1] 80 75 150 90 \
  828.             -b OK 20 120 85 140 -b Cancel 110 120 175 140]
  829.             
  830.             if {[lindex $values 3]} {return}
  831.             set colorname [string trim [lindex $values 0]]
  832.             set colornumber [string trim [lindex $values 1]]
  833.             set coltest [htmlCheckColorNumber $colornumber]
  834.             if {$coltest == "0"} {
  835.                 alertnote "$colornumber is not a valid color number. It should be of the form #RRBBGG."
  836.                 continue
  837.             }
  838.             set colornumber $coltest
  839.             if {[htmlColorIdentical $colornumber $changeColor]} {return}
  840.         } else {
  841.             if {[htmlColorIdentical $colornumber $changeColor]} {return}
  842.             if {[catch {prompt "Color name" $changeColor} colorname]} { 
  843.                 # cancel
  844.                 return
  845.             }
  846.             set colorname [string trim $colorname]
  847.         }
  848.         if {[lsearch -exact $basicColors $colorname] >= 0} {
  849.             alertnote "Predefined color. Choose another name."
  850.         } elseif {[string length $colorname]} {
  851.             set replace 0
  852.             if {[lsearch -exact $alluserColors $colorname] >= 0 && \
  853.             $colorname != $changeColor} {
  854.                 set repl [dialog -w 200 -h 75 -b Cancel 20 40 80 60 \
  855.                 -b Replace 115 40 175 60 \
  856.                 -t "Replace $colorname?" 10 10 150 30]
  857.                 if {[lindex $repl 1] } { 
  858.                     set replace 1
  859.                     # remove the color first 
  860.                     set oldnumber $htmluserColors($colorname)
  861.                     htmlColordelete $colorname $oldnumber
  862.                 }
  863.             } else {
  864.                 set replace 1
  865.             }
  866.             # add the new color
  867.             if {$replace} { 
  868.                 if {[string length $changeColor]} {
  869.                     htmlColordelete $changeColor $changeNumber
  870.                 }
  871.                 set noname 0
  872.                 htmlColordef $colorname $colornumber
  873.                 message $msg
  874.             }
  875.         } else {
  876.             alertnote "You must name the color."
  877.         }
  878.     }
  879.     return $colorname
  880. }
  881.  
  882.  
  883. proc htmlColordef {colorname colornumber} {
  884.     global htmluserColors htmluserColorname
  885.     
  886.     set htmluserColors($colorname) $colornumber
  887.     set htmluserColorname($colornumber) $colorname
  888.     addArrDef htmluserColors $colorname $colornumber
  889.     addArrDef htmluserColorname $colornumber $colorname
  890. }
  891.  
  892. proc htmlColordelete {colorname colornumber} {
  893.     global htmluserColors htmluserColorname
  894.     
  895.     catch {unset htmluserColors($colorname)}
  896.     catch {unset htmluserColorname($colornumber)}
  897.     removeArrDef htmluserColors $colorname
  898.     removeArrDef htmluserColorname $colornumber
  899. }
  900.  
  901.  
  902. # Check if a color number is a valid number, or one of the predefined names.
  903. # Returns 0 if not and the color number if it is.
  904. proc htmlCheckColorNumber {color} {
  905.     global htmlColorName
  906.     set color [string tolower $color]
  907.     if {[info exists htmlColorName($color)]} {return $htmlColorName($color)}
  908.     if {[string index $color 0] != "#"} {
  909.         set color "#${color}"
  910.     }
  911.     set color [string toupper $color]
  912.     if {[string length $color] != 7 || ![regexp {^#[0-9A-F]+$} $color]} {
  913.         return 0
  914.     } else {
  915.         return $color
  916.     }    
  917. }
  918.  
  919. #===============================================================================
  920. # Colors for background, text and links
  921. #===============================================================================
  922.  
  923.  
  924. proc htmlNewColor {var val } {
  925.     global htmlColorName
  926.     global htmlColorNumber
  927.     set htmlColorName($var) $val 
  928.     set htmlColorNumber($val) $var
  929. }
  930. htmlNewColor black        "#000000"
  931. htmlNewColor silver        "#C0C0C0"
  932. htmlNewColor gray        "#808080"
  933. htmlNewColor white        "#FFFFFF"
  934. htmlNewColor maroon        "#800000"
  935. htmlNewColor red        "#FF0000"
  936. htmlNewColor purple        "#800080"
  937. htmlNewColor fuchsia    "#FF00FF"
  938. htmlNewColor green        "#008000"
  939. htmlNewColor lime        "#00FF00"
  940. htmlNewColor olive        "#808000"
  941. htmlNewColor yellow        "#FFFF00"
  942. htmlNewColor navy        "#000080"
  943. htmlNewColor blue        "#0000FF"
  944. htmlNewColor teal        "#008080"
  945. htmlNewColor aqua        "#00FFFF"
  946.  
  947. # Remove colors conflicting with the new ones
  948. foreach tmpCol [array names htmluserColors] {
  949.     if {[info exists htmlColorName($tmpCol)]} {
  950.         htmlColordelete $tmpCol $htmluserColors($tmpCol)
  951.     }
  952. }
  953. foreach tmpCol [array names htmluserColorname] {
  954.     if {[info exists htmlColorNumber($tmpCol)]} {
  955.         htmlColordelete $htmluserColorname($tmpCol) $tmpCol
  956.     }
  957. }
  958. catch {unset tmpCol}
  959. # A list of colours
  960. set basicColors [lsort [array names htmlColorName]]
  961. rename htmlNewColor ""
  962.